home *** CD-ROM | disk | FTP | other *** search
/ PC Media 2 / PC MEDIA CD02.iso / share / prog / optasm / fcopy.bas < prev    next >
Encoding:
BASIC Source File  |  1993-06-09  |  3.9 KB  |  139 lines
  1.     DEFINT A-Z
  2.     TYPE RegType
  3.         AX    AS INTEGER
  4.         BX    AS INTEGER
  5.         CX    AS INTEGER
  6.         DX    AS INTEGER
  7.         BP    AS INTEGER
  8.         SI    AS INTEGER
  9.         DI    AS INTEGER
  10.         Flags AS INTEGER
  11.         DS    AS INTEGER
  12.         ES    AS INTEGER
  13.     END TYPE
  14.     
  15.     DIM SHARED Regs AS RegType
  16.     DECLARE SUB FGetArray (Handle, Buffer$, Bytes&)
  17.     DECLARE SUB FPutArray (Handle, Buffer$, Bytes&)
  18.     DECLARE SUB InstallCEH ()
  19.     DECLARE SUB RemoveCEH ()
  20.     DECLARE FUNCTION CEHError ()
  21.     DECLARE FUNCTION Exist (FileName$)
  22.     DECLARE FUNCTION FileCopy (Src$, Dest$, Buffer$)
  23.  
  24.     Buffer$ = STRING$(4096, 0)
  25.     Result = FileCopy("A:TEST.IN", "A:TEST.OUT", Buffer$)
  26.     SELECT CASE Result
  27.         CASE -1
  28.             PRINT "File(s) copied OK."
  29.         CASE 0
  30.             PRINT "Disk is write-protected."
  31.         CASE 1
  32.             PRINT "Invalid drive letter."
  33.         CASE 2
  34.             PRINT "Drive not ready."
  35.         CASE 7
  36.             PRINT "Disk not formatted."
  37.         CASE 10
  38.             PRINT "Write error."
  39.         CASE 11
  40.             PRINT "Read error."
  41.         CASE 53
  42.             PRINT "File not found."
  43.         CASE 61
  44.             PRINT "Disk is full."
  45.         CASE ELSE
  46.             PRINT "Critical error."
  47.     END SELECT
  48.     END
  49.  
  50. FUNCTION Exist (FileSpec$)
  51.  
  52.     CALL InstallCEH
  53.     Temp$ = FileSpec$ + CHR$(0)
  54.     Regs.AX = &H4E00                       'Find first matching file
  55.     Regs.CX = 0
  56.     Regs.DS = VARSEG(Temp$)
  57.     Regs.DX = SADD(Temp$)
  58.     CALL InterruptX(&H21, Regs, Regs)
  59.     CALL RemoveCEH
  60.     IF (CEHError > -1) OR (Regs.AX AND 255) THEN
  61.        Exist = 0
  62.     ELSE
  63.        Exist = -1
  64.     END IF
  65.  
  66. END FUNCTION
  67.  
  68. SUB FGetArray (Handle, Buffer$, Bytes&)
  69.  
  70.     CALL InstallCEH
  71.     Regs.AX = &H3F00                             'Read file service.
  72.     Regs.BX = FILEATTR(Handle, 2)                'DOS file handle.
  73.     Regs.CX = Bytes& OR -(Bytes& AND &H8000)     'Convert to unsigned int.
  74.     Regs.DS = VARSEG(Buffer$)
  75.     Regs.DX = SADD(Buffer$)
  76.     Regs.ES = -1: Regs.BP = -1
  77.     CALL InterruptX(&H21, Regs, Regs)
  78.     CALL RemoveCEH
  79.     Bytes& = Regs.AX AND &HFFFF&                 'Convert to signed int.
  80.     IF (Regs.Flags AND 1) THEN
  81.       Bytes& = -1                               'Error!
  82.     END IF
  83.  
  84. END SUB
  85.  
  86. FUNCTION FileCopy (Src$, Dest$, Buffer$)
  87.  
  88.     IF NOT Exist(Src$) THEN
  89.       ErrCode = CEHError                   'Get critical error code.
  90.       IF ErrCode = -1 THEN                 'If code is -1, then return
  91.         ErrCode = 53                      'code for 'file not found'.
  92.       END IF
  93.       FileCopy = ErrCode
  94.       EXIT FUNCTION
  95.     END IF
  96.  
  97.     Src = FREEFILE
  98.     OPEN Src$ FOR BINARY AS Src             'Open source file.
  99.     Dest = FREEFILE                         'Open dest file for output,
  100.     OPEN Dest$ FOR OUTPUT AS Dest           'to truncate it if it exists.
  101.  
  102.     Remaining& = LOF(Src)                   'Keep track of bytes
  103.     DO WHILE Remaining& > 0                 'to be copied.
  104.       Bytes& = LEN(Buffer$)
  105.       CALL FGetArray(Src, Buffer$, Bytes&)      'Get a chunk from Src.
  106.       IF Bytes& = -1 THEN EXIT DO               'Exit if error.
  107.       CALL FPutArray(Dest, Buffer$, Bytes&)     'Write array to Dest.
  108.       IF Bytes& <= 0 THEN EXIT DO
  109.       Remaining& = Remaining& - Bytes&     'Adjust Remaining& and
  110.     LOOP                                    '  do it again.
  111.     IF Bytes& = 0 THEN
  112.       ErrCode = 61                         'Disk full.
  113.     ELSE
  114.       ErrCode = CEHError                   'Return error code.
  115.     END IF
  116.     CLOSE Src, Dest                         'Close 'em.
  117.     FileCopy = ErrCode
  118.  
  119. END FUNCTION
  120.  
  121. SUB FPutArray (Handle, Buffer$, Bytes&)
  122.  
  123.     CALL InstallCEH
  124.     Regs.AX = &H4000                             'Read file service.
  125.     Regs.BX = FILEATTR(Handle, 2)                'DOS file handle.
  126.     Regs.CX = Bytes& OR -(Bytes& AND &H8000)     'Convert to unsigned int.
  127.     Regs.DS = VARSEG(Buffer$)
  128.     Regs.DX = SADD(Buffer$)
  129.     Regs.ES = -1: Regs.BP = -1
  130.     CALL InterruptX(&H21, Regs, Regs)
  131.     CALL RemoveCEH
  132.     Bytes& = Regs.AX AND &HFFFF&                 'Convert to signed int.
  133.     IF (Regs.Flags AND 1) THEN
  134.       Bytes& = -1                               'Error!
  135.     END IF
  136.  
  137. END SUB
  138.  
  139.